Cream of the Crop 21/Cream of the Crop 21 (Terry Blount) (October 1996).iso/program/srcbkvt.zip/LISTBOX.ASC

Text File | 1996-07-08 | 7KB | 308 lines

_Writing Delphi Components_
by William Stamatakis

Listing One
{ * Unit Name: tbillist.pas
  * Author:    William Stamatakis
  * Note:      Multi-Char Listbox Component (TBillListBox)
}
unit TBillist;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, FindDlg, Buttons, DsgnIntf, About;
type
  TAboutProperty = class(TPropertyEditor)
public
  procedure Edit; override;
  function GetAttributes: TPropertyAttributes; override;
  function GetValue: string; override;
end;
type TItemsProperty = class(TPropertyEditor)
public
  procedure Edit; override;
  function GetAttributes: TPropertyAttributes; override;
  function GetValue: string; override;
end;
type
  TBillListBox = class(TListBox)
  private
    dlgFind: TdlgFind;
    FAutoSearch: Boolean;
    FAbout: ShortInt;
  protected
    procedure KeyPress(var Key: Char); override;
  public
    procedure FindItemDlg(const SearchItem: string);
    function SearchList(Item: PChar): Integer;
    procedure SetCurrentIndex( CurrIndex: LongInt);
  published
    property AutoSearch: Boolean read FAutoSearch write FAutoSearch
             default False;
    property About: ShortInt read FAbout write FAbout;
end;
var
  CurrentIndex: LongInt;
procedure Register;

implementation

uses Listdlg;
{TAboutProperty Methods.}
procedure TAboutProperty.Edit;
var
  dlgAbout: TAboutbox;
begin
  dlgAbout := TAboutbox.Create(Application);   dlgAbout.ShowModal;
end;
function TAboutProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

function TAboutProperty.GetValue: string;
begin
  Result := 'About Listbox Gadget...';
end;
{TItemsProperty Methods.}
procedure TItemsProperty.Edit;
var
  dlgEditor: TListEditor;
  objListBox: TBillListBox;
begin
try
  objListBox := (self.GetComponent(0) as TBillListBox);
  dlgEditor := TListEditor.Create(Application);
  dlgEditor.SetReferenceTo(objListBox);
  dlgEditor.lstItems.Clear;
  dlgEditor.lstItems.Items.AddStrings(objListBox.Items);
  dlgEditor.ShowModal;
finally
  dlgEditor.Free;
end;
end;
function TItemsProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;
function TItemsProperty.GetValue: string;
begin
  Result := 'Click to add/modify items...';
end;
{TBillListBox Methods.}
procedure TBillListBox.FindItemDlg(const SearchItem: string);
begin
try
  dlgFind := TdlgFind.Create(self);
  dlgFind.Top := self.Parent.Top + self.Top;
  dlgFind.Left := self.Parent.Left + self.Left;
  dlgFind.edtFind.Text := SearchItem;
  dlgFind.edtFind.SelStart := 1;
  dlgFind.edtFind.AutoSelect:= False;
  dlgFind.ShowModal;
finally
  dlgFind.Free;
end;
end;
function TBillListBox.SearchList(Item: PChar): Integer;
var
  ItemFound: LongInt;
begin   ItemFound := SendMessage(Handle,
                         LB_FINDSTRING, CurrentIndex, LongInt(Item));
  if ItemFound = LB_ERR then
      begin
      CurrentIndex := 0;
      MessageDlgPos('Item not Found.', mtWarning, [mbOK],
                    0, dlgFind.Left + 75, dlgFind.Top);
      end
  else
      ItemIndex := ItemFound;

  CurrentIndex := ItemFound;
  Result := ItemFound;
end;
procedure TBillListBox.SetCurrentIndex(CurrIndex: LongInt);
begin
CurrentIndex := CurrIndex;
end;
procedure TBillListBox.KeyPress(var Key: Char);
begin
{ Activate AutoSearch Dialog if the the AutoSearch property is set to True and
  the Esc key and the Enter key have not been pressed. }
if (AutoSearch) then
   begin
   if ( (Key <> Chr(27)) and (Key <> Chr(13)) ) then
     begin
     { Activate Listbox AutoSearch Dialog }
     self.FindItemDlg(Key);
     { Disable Listbox KeyPress event by setting Key := null }
     Key := #0;
     end;
   end
else
   { Do default bahavior}
   inherited KeyPress(Key);
end;
procedure Register;
begin
  RegisterComponents('Samples', [TBillListBox]);
  RegisterPropertyEditor(TypeInfo(ShortInt), TBillListBox, 'About',
                                                              TAboutProperty);
  RegisterPropertyEditor(TypeInfo(TStrings), TBillListBox, 'Items',
                                                              TItemsProperty);
end;
initialization
  CurrentIndex := 0;
end.

Listing Two
{ * Unit Name: finddlg.pas
  * Author:    William Stamatakis
  * Note:      Search List Dialog for Multi-Char Listbox Component (TdlgFind)
}
unit Finddlg;
interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons;
type
  TdlgFind = class(TForm)
    edtFind: TEdit;
    Label1: TLabel;
    btnFindNext: TBitBtn;
    btnClose: TBitBtn;
    procedure ButtonsClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
 end;
var
  dlgFind: TdlgFind;

implementation
uses Tbillist;

{$R *.DFM}

procedure TdlgFind.ButtonsClick(Sender: TObject);
var
  strFind: string;
  pFind: PChar;
begin
if Sender = btnClose then
  begin
  (Owner as TBillListBox).SetCurrentIndex(0);
  Close;
  end
else
  begin
  strFind := edtFind.Text;
  pFind := @strFind;
  StrPCopy(pFind, strFind);
  (Owner as TBillListBox).SearchList(pFind);
  end;
end;
end.




Example 1:

(a)
type TBillListBox = class(TListBox)

(b)

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, FindDlg, Buttons, DsgnIntf, About;

(c)

published
    property AutoSearch: Boolean read FAutoSearch write FAutoSearch default False;


(d)

protected
    procedure KeyPress(var Key: Char); override;
 ...
procedure TBillListBox.KeyPress(var Key: Char);
begin
{ Activate AutoSearch Dialog if the AutoSearch property is set to True and
  the Esc key and the Enter key have not been pressed. }
if (AutoSearch) then
   begin
   if ( (Key <> Chr(27)) and (Key <> Chr(13)) ) then
     begin
     { Activate Listbox AutoSearch Dialog }
     self.FindItemDlg(Key);
     { Disable Listbox KeyPress event by setting Key := null }
     Key := #0;
     end;
   end
else
   { Do default bahavior}
   inherited KeyPress(Key);
end;

Example 2:

(a)

(Owner as TBillListBox).SearchList(pFind);


(b)

ItemFound := SendMessage(Handle, LB_FINDSTRING, CurrentIndex, LongInt(Item));


(c)

public
    procedure FindItemDlg(const SearchItem: string);
    procedure SearchList(Item: PChar);
    procedure SetCurrentIndex( CurrIndex: LongInt);

Example 3:

(a)
type
  TItemsProperty = class(TPropertyEditor)
public
  procedure Edit; override;
  function GetAttributes: TPropertyAttributes; override;
  function GetValue: string; override;
end;


(b)

function TItemsProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

(c)
function TItemsProperty.GetValue: string;
begin
  Result := 'Click to add/modify items...';
end;

(d)

RegisterPropertyEditor(TypeInfo(TStrings), TBillListBox, 'Items',TItemsProperty);

(e)

RegisterComponents('Samples', [TBillListBox]);